The Best of MacTutor - S…e Code for Volumes 1 to 5/The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin/Source Code/#27 (Dec 87)/Pascal MIDI shell/MIDIShell.Pas

Pascal/Delphi Source File | 1987-07-15 | 6KB | 289 lines

{ Kirk Austin, 7/12/87 }
{ This is an example program that illustrates the following techniques: }
{ My preferred method for handling the about box }
{The use of the transfer command in the file menu }
{The use of the LSPMIDI library including MIDIThru}

PROGRAM ShellExample;

    USES
        LSPMIDI;

{ Global Constants }
    CONST
        Null = '';

        AppleMenuID = 1;

        FileMenuID = 2;

        EditMenuID = 3;

        MIDIMenuID = 4;

        AboutID = 200;

{ Global Variables }

    VAR
        myMenus : ARRAY[AppleMenuID..MIDIMenuID] OF MenuHandle;
        Done : Boolean;            { true when user selects quit}

{This is a way to do the about box so that it doesn't interfere with the application.}
{For instance, you can make menu selections while the about box is visible.}
    PROCEDURE ShowAbout;
        VAR
            theDlog : DialogPtr;
            oldPort : GrafPtr;
    BEGIN
        GetPort(oldPort);
        theDlog := GetNewDialog(AboutID, NIL, Pointer(-1));
        SetPort(theDlog);
        DrawDialog(theDlog);
        WHILE NOT Button DO
            ;
        DisposDialog(theDlog);
        SetPort(oldPort);
    END;

    PROCEDURE LaunchIt (mode : integer;
                                    VAR fName : Str255);
    INLINE
        $204F,     {movea.l  a7,a0        ; (a0) is a ptr to string, 4(a0) is mode}
        $A9F2;    {_Launch}


    PROCEDURE DoXfer;
        VAR
            where : Point;
            reply : SFReply;
            vRef : integer;
            thefName : Str255;
            textType : SFTypeList;
    BEGIN
        where.h := 80;
        where.v := 55;
        textType[0] := 'APPL';
        SFGetFile(where, Null, NIL, 1, textType, NIL, reply);
        WITH reply DO
            IF NOT good THEN
                thefName := Null
            ELSE
                BEGIN
                    thefName := fName;
                    vRef := vRefNum
                END;
        IF thefName <> Null THEN
            BEGIN
                Done := true;
                IF SetVol(NIL, vRef) = noErr THEN
                    BEGIN
                        ResetSCCA;
                        ResetSCCB;
                        QuitTimer;
                        LaunchIt(0, thefName)
                    END;
            END
    END;

    PROCEDURE ProcessMenu (codeWord : Longint);    { handle menu selections}
        VAR
            i : integer;
            menuNum : Integer;
            TheMenuHdle : MenuHandle;
            itemNum : Integer;
            NameHolder : str255;
            dummy : Integer;
            ignore : boolean;
            TheValue : longint;

    BEGIN
        IF codeWord <> 0 THEN    { nothing was selected}
            BEGIN
                menuNum := HiWord(codeWord);
                itemNum := LoWord(codeWord);
                CASE menuNum OF { the different menus}
                    AppleMenuID :
                        BEGIN
                            IF itemNum < 3 THEN
                                BEGIN
                                    ShowAbout;
                                END
                            ELSE
                                BEGIN
                                    GetItem(myMenus[AppleMenuID], itemNum, NameHolder);
                                    dummy := OpenDeskAcc(NameHolder);
                                END;
                        END;
                    FileMenuID :
                        BEGIN
                            CASE ItemNum OF
                                1 :
                                    BEGIN
                                        DoXfer;
                                    END;
                                2 :
                                    BEGIN
                                        Done := true;
                                    END;
                            END;
                        END;
                    EditMenuID :
                        BEGIN
                            ignore := SystemEdit(itemNum - 1);
                        END;
                    MIDIMenuID :
                        BEGIN
                            TheMenuHdle := GetMHandle(4);
                            FOR i := 1 TO 5 DO
                                CheckItem(TheMenuHdle, i, false);
                            MIDIThruA(0);
                            MIDIThruB(0);
                            CASE ItemNum OF
                                1 :
                                    BEGIN
                                        CheckItem(TheMenuHdle, 1, true);
                                        MIDIThruA(1);
                                    END;
                                2 :
                                    BEGIN
                                        CheckItem(TheMenuHdle, 2, true);
                                        MIDIThruA(2);
                                    END;
                                3 :
                                    BEGIN
                                        CheckItem(TheMenuHdle, 3, true);
                                        MIDIThruB(1);
                                    END;
                                4 :
                                    BEGIN
                                        CheckItem(TheMenuHdle, 4, true);
                                        MIDIThruB(2);
                                    END;
                                5 :
                                    BEGIN
                                        CheckItem(TheMenuHdle, 5, true);
                                        MIDIThruA(0);
                                        MIDIThruB(0);
                                    END;
                            END;
                        END;
                END;
                HiliteMenu(0);
            END;
    END;

{ }
    PROCEDURE DealWithMouseDowns (theEvent : EventRecord);
        VAR
            location : Integer;
            windowPointedTo : WindowPtr;
            mouseLoc : point;
            windowLoc : integer;
            VandH : Longint;
            Height : Integer;
            Width : Integer;
    BEGIN
        mouseLoc := theEvent.where;
        windowLoc := FindWindow(mouseLoc, windowPointedTo);
        CASE windowLoc OF
            inMenuBar :
                BEGIN
                    ProcessMenu(MenuSelect(mouseLoc));
                END;
            inSysWindow :
                BEGIN
                    SystemClick(theEvent, windowPointedTo);
                END;
            OTHERWISE
                BEGIN
                END;
        END;
    END;

    PROCEDURE DealWithKeyDowns (theEvent : EventRecord);
        TYPE
            Trick = PACKED RECORD
                    CASE boolean OF
                        true : (
                                long : Longint
                        );
                        false : (
                                chr3, chr2, chr1, chr0 : char
                        )
                END;
        VAR
            CharCode : char;
            TrickVar : Trick;
    BEGIN
        TrickVar.long := theEvent.message;
        CharCode := TrickVar.chr0;
        IF BitAnd(theEvent.modifiers, CmdKey) = CmdKey THEN {check for a menu selection}
            BEGIN
                ProcessMenu(MenuKey(CharCode));
            END
    END;

    PROCEDURE MainEventLoop;
        VAR
            Event : EventRecord;
            ProcessIt : boolean;
            x : byte;
            TheValue : Longint;
    BEGIN
        REPEAT
            SystemTask;
            ProcessIt := GetNextEvent(everyEvent, Event); { get the next event in queue}
            IF ProcessIt THEN
                BEGIN
                    CASE Event.what OF
                        mouseDown :
                            DealWithMouseDowns(Event);
                        AutoKey :
                            DealWithKeyDowns(Event);
                        KeyDown :
                            DealWithKeyDowns(Event);
                        OTHERWISE
                            BEGIN
                            END;
                    END;
                END;
        UNTIL Done;
    END;

    PROCEDURE MakeMenus;        { get the menus & display them}
        VAR
            index : Integer;
            TheMenuHdle : MenuHandle;
    BEGIN
        FOR index := AppleMenuID TO MIDIMenuID DO
            BEGIN
                myMenus[index] := GetMenu(index);
                InsertMenu(myMenus[index], 0);
            END;
        AddResMenu(myMenus[AppleMenuID], 'DRVR');
        DrawMenuBar;
    {put a check mark on the "none" menu item by default}
        TheMenuHdle := GetMHandle(4);
        CheckItem(TheMenuHdle, 5, true);
    END;

{ Program Starts Here }
BEGIN
    Done := false;
    FlushEvents(everyEvent, 0);

    InitSCCA;
    InitSCCB;
    InitTimer(782 * 5);    {increment the counter every 5 milliseconds}
    StartCounter;

    MakeMenus;
    InitCursor;
    MainEventLoop;

    ResetSCCA;
    ResetSCCB;
    QuitTimer;

END.